home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 January / macformat-033.iso / mac / Shareware City / Developers / CGIshell Folder / Pocket 6.4 / Examples / IntegerTrig < prev    next >
Encoding:
Text File  |  1992-05-07  |  3.0 KB  |  71 lines  |  [TEXT/McSk]
  1. ( Integer math routines for Pocket Forth 0.6 )
  2. forget task : task ; decimal
  3.  
  4. : 2ROOT ( d -- n ) ( square root ) ( Forth assembler syntax )
  5.     ,$ 48E7  ,$ 2800  ( .long SP -] 2800 movem>, )
  6.     ,$ 2016           ( PS ] D0 move, )
  7.     ,$ 383C  ,$ 000F  ( .word  15 # D4 move,  .long )
  8.     ,$ 7200  ,$ 7400  ( 0 D1 moveq, 0 D2 moveq, )
  9.     ,$ E380  ,$ E391  ( DO,  1 # D0 asl,  1 # D1 roxl, )
  10.     ,$ E380  ,$ E391  (   1 # D0 asl,  1 # D1 roxl, )
  11.     ,$ E382  ,$ 2602  (   1 # D2 asl,  D2 D3 move, )
  12.     ,$ E383  ,$ B283  (   1 # D3 asl,  D3 D1 cmp, )
  13.     ,$ 6306           (   ls IF, )
  14.     ,$ 5282  ,$ 5283  (     1 D2 addq,  1 D3 addq, )
  15.     ,$ 9283           (     D3 D1 sub,  THEN, )
  16.     ,$ 51CC  ,$ FFE6  ( D4 LOOP, )
  17.     ,$ 2C82           ( D2 PS ] move, )
  18.     ,$ 4CDF  ,$ 0014  ( 14 SP ]+ movem<, )
  19.     drop ;
  20. : ^2 ( n -- d ) dup u* ;  ( square )
  21.  
  22. variable TTABLE  0 ttable !  ( sines*10000 )
  23.     00175 , 00349 , 00524 , 00698 , 00872 , 01045 , 01219 , 01392 ,
  24.     01571 , 01736 , 01908 , 02079 , 02250 , 02419 , 02588 , 02756 ,
  25.     02924 , 03090 , 03256 , 03420 , 03584 , 03746 , 03907 , 04067 ,
  26.     04226 , 04384 , 04540 , 04695 , 04848 , 05000 , 05150 , 05299 ,
  27.     05446 , 05592 , 05736 , 05878 , 06018 , 06157 , 06293 , 06428 ,
  28.     06561 , 06691 , 06820 , 06947 , 07071 , 07193 , 07314 , 07431 ,
  29.     07547 , 07660 , 07771 , 07880 , 07986 , 08090 , 08192 , 08290 ,
  30.     08387 , 08480 , 08572 , 08660 , 08746 , 08829 , 08910 , 08988 ,
  31.     09063 , 09135 , 09205 , 09272 , 09336 , 09397 , 09455 , 09511 ,
  32.     09563 , 09613 , 09659 , 09703 , 09744 , 09781 , 09816 , 09848 ,
  33.     09877 , 09903 , 09925 , 09945 , 09962 , 09976 , 09986 , 09994 ,
  34.     09998 , 10000 ,
  35.  
  36. : ?NEGATE ( n f -- n or -n ) IF negate THEN ;
  37. : FIXANGLE ( degrees -- degrees' ) ( map angle to -180° to 180° range )
  38.     dup abs  BEGIN  dup 180 > WHILE  360 - REPEAT
  39.     swap 0< ?negate ;
  40.  
  41. : SIN ( degrees -- sin*10000 ) ( -180°≤angle≤180° )
  42.     fixangle dup 0< >r  abs  dup 90 > IF  180 swap - THEN
  43.       2* ttable + @  r> ?negate ;
  44. : COS ( degrees -- cos*10000 )
  45.     dup 0< IF 90 + sin  ELSE  90 - sin negate THEN ;
  46. : ARCSIN ( sine*10000 -- degrees )
  47.     dup 0< >r  abs  ( save sign )
  48.       91 0 DO  ( check all angles )
  49.         dup r 2* ttable + @ > 0= IF  ( if sin>table value )
  50.         drop r  leave THEN  LOOP 1-
  51.     r> ?negate ; ( restore sign )
  52.  
  53. ( interpolate for greater accuracy )
  54. : SINE ( angle thousanths -- sine*10000 )
  55.     >r  >r  r sin  r> 1+ sin  over -  r> 1000 */ + ;
  56. : COSINE ( angle thousanths -- cosine*10000 )
  57.     >r >r  r cos  r> 1+ cos  over -  r> 1000 */ + ;
  58.  
  59. : TEST  ( test this out )
  60.     100 150 !pen  275 150 -to  275 75 -to  100 150 -to
  61.     277 120 !pen ." 30 mm."  170 162 !pen ." 75 mm."
  62.     128 148 !pen  30 ^2  75 ^2 d+ 2root  ( hypotenuse )
  63.     30 10000 rot */  arcsin . 161 emit  cr ;
  64.  
  65. room  page
  66. ( You have just loaded some integer math routines. They're )
  67. ( about twice as fast as their floating point counterparts,)
  68. ( with a coprocessor, ten times as fast without.           )
  69. ( Examine the IntegerTrig file to see how it was done      ).
  70. ( bytes of dictionary left. ) test
  71.